Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostu2/tunnel1.pas

Pascal/Delphi Source File | 1994-10-28 | 4.1 KB | 246 lines

program MegaDotTunnel;
{
    DotTunnel1
    - by Bjarke Viksoe
    around mar 1994

    All tunnel coords are precalculated, but centered around (0,0).
    We can then draw each circle but with a new origo.
    Screen mode is $13. Sorry. This source is rather old.
}

uses
    DEMOINIT;

const
    antalringe = 256;
    antaldots = 32;
    ringspace = 4;
    showantal = antalringe DIV ringspace;
    ialt = showantal*antaldots;

type
    bufferpointer = ^coordbuffer;
    coordbuffer = array [1..antalringe, 1..antaldots] of integer;

var
    oldmode, oldpage : shortint;
    sinustabel        : array[0..639] of integer;
    oldcoordbuffer    : array[1..ialt] of integer;
    vinkel            : integer;
    i,j                : integer;

    twist                : boolean;
    xpos, ypos        : word;
    ringpos            : word;
    bufferptr         : bufferpointer;


(*-----------------------------------------------------------*)

procedure OpenScreen;
var
    i, color : integer;
begin
    asm
    mov     ah,$0F
    int     $10
    mov     oldmode,al

    mov     al,$13
    xor     ah,ah
    int     $10
    end;

     color := 64;
     for i:=1 to 64 do begin
        SetRGB(i, color,color,color);
        dec(color);
     end;
end;

procedure CloseScreen;
begin
      asm
     mov    al,oldmode
     xor    ah,ah
     int    $10
     end;
end;


(*-----------------------------------------------------------*)

procedure setupsinus;
var
    i : integer;
    v, vadd : real;
begin
    for i:=1 to ialt do
        oldcoordbuffer[i]:=0;

    v:=0.0;
    vadd:=(2.0*pi/512.0);
    for i:=0 to 639 do begin
        sinustabel[i]:=round(sin(v)*32767);
        v:=v+vadd;
    end;
end;


procedure CalcCircler;
var
    i,j                    : integer;
    v,vtemp,vadd        : word;
    vinkel1, vinkel2    : integer;
    x,y                    : longint;
    cx,cy                : longint;
begin

    x := 350;
    y := 0;

    v := 0;
    vadd := 512 DIV antaldots;
    for i:=1 to antalringe do
    begin
          vtemp := v;
        for j:=1 to antaldots do
        begin
            vinkel1:=sinustabel[vtemp];
            vinkel2:=sinustabel[vtemp+128];
            cx := (x*vinkel2 - y*vinkel1) DIV 32768;
            cy := (x*vinkel1 + y*vinkel2) DIV 32768;
            cx := (cx shl 8) DIV 800;
            cy := (cy shl 8) DIV 800;

            if (cy<-100) OR (cy>100) then
                cy:=104;

            bufferptr^[i,j] := (cy*320)+cx;
            vtemp := (vtemp+vadd) mod 512;
        end;
        inc(v);
        dec(x,1);
    end;
end;

(*-----------------------------------------------------------*)


procedure RestoreBackground;
begin
    asm
        lea        si,oldcoordbuffer
        mov        ax,$A000
        mov        es,ax
        xor        ax,ax
        mov        cx,ialt
@loop:
        mov        bx,[si]
        mov        [es:bx],al
        inc        si
        inc        si
        loop    @loop
    end;
end;


procedure DotTunnel(scrpos : integer; color : byte; ring : integer;
                    bufferadd : integer);
begin
    ring := ring*(antaldots*2);

    asm
        mov    ax,$A000
        mov    es,ax

        lea    di,oldcoordbuffer
        add   di,bufferadd
        mov    dx,scrpos
        mov    cl,color

        mov    ax,WORD PTR bufferptr+2
        mov    si,WORD PTR bufferptr
        add    si,ring
        {mov    fs,ax} DB $8E,$E0

        mov    al,cl
        mov    cx,antaldots
@dotloop:
        DB FS; mov bx,[si]
        add    bx,dx
        mov    [es:bx],al
        inc    si
        inc    si
        mov    [ds:di],bx
        inc    di
        inc    di
        loop    @dotloop
    end;

end;



procedure TunnelSteering;
var
    i                : integer;
    tempx, tempy    : word;
    ringnr            : word;
    bufferadd        : integer;
    x,y,z            : integer;
begin
    tempx := xpos; tempy := ypos;
    z := 7500;
    ringnr := ringpos;
    bufferadd := 0;

    for i:=1 to showantal do
    begin
        x := 160+(sinustabel[tempx mod 512] DIV z);
        y := 100+(sinustabel[tempy mod 512] DIV z);
        DotTunnel(y*320+x, i, ringnr, bufferadd);
        dec(z,115);
        inc(tempx,4); inc(tempy,3);
        inc(ringnr,ringspace);
        inc(bufferadd,antaldots*2);
    end;

    twist := NOT twist;
    if (twist) then
        ringpos := (ringpos+1) mod ringspace
end;


procedure go;
begin
    VBLANK_QUICK;
    RestoreBackground;
    TunnelSteering;
end;


(*-----------------------------------------------------------*)

begin
    SetupSinus;
    new(bufferptr);
    CalcCircler;
    OpenScreen;

    twist := TRUE;
    xpos := 0; ypos := 0;
    ringpos := 0;

    for i:=1 to 500 do begin
        go;
        dec(xpos,2);
        inc(ypos,1);
    end;

    CloseScreen;
    dispose(bufferptr);
end.